home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / flags.tcl < prev    next >
Encoding:
Text File  |  1994-09-08  |  3.8 KB  |  173 lines  |  [TEXT/ALFA]
  1.  
  2. set tclvars {}
  3.  
  4. set allFlags ""
  5. set allVars ""
  6.  
  7. # The following three procs, together w/ the initialization 
  8. # for the flags below, allow a totally Tcl-controlled menu to 
  9. # shadow Alpha's internal variables.
  10. proc initFlag {var {val ""}} {
  11.     global $var modeVars tclvars allFlags
  12.     if {[lsearch -exact $tclvars $var] < 0} {
  13.         lappend tclvars $var
  14.     }
  15.     linkVar $var
  16.     if {[string length $val]} {set $var $val}
  17.     lappend allFlags $var
  18. }
  19.  
  20. # Called for ordinary tcl global vars we want included in the Flags menu.
  21. proc initTclFlag {flag {val 0}} {
  22.     global $flag allFlags tclvars modeVars
  23.     if {[lsearch -exact $tclvars $flag] < 0} {
  24.         lappend tclvars $flag
  25.     }
  26.     if {![info exists $flag]} {set $flag $val}
  27.     lappend allFlags $flag
  28. }
  29.  
  30. # Called for ordinary tcl global vars we want included in the Vars menu.
  31. proc initTclVar {var {val ""}} {
  32.     global $var tclvars modeVars allVars
  33.     if {[lsearch -exact $tclvars $var] < 0} {
  34.         lappend tclvars $var
  35.     }
  36.     if {[string length $val]} {
  37.         set $var $val
  38.     }
  39.     if {![info exists $var]} {set $var 0}
  40.     lappend allVars $var
  41. }
  42.  
  43. proc initVar {var {val ""}} {
  44.     global $var tclvars modeVars allVars
  45.     if {[lsearch -exact $tclvars $var] < 0} {
  46.         lappend tclvars $var
  47.     }
  48.     linkVar $var
  49.     if {[string length $val]} {
  50.         set $var $val
  51.     }
  52.     lappend allVars $var
  53. }
  54.  
  55. # 'fullNames' needs to be traced to update win menu.
  56. if {![info exists oldFNames]} {set oldFNames 0}
  57. proc shadowFullNames args {
  58.     global winNameToNum fullNames oldFNames winMenu
  59.     
  60.     if {$fullNames == $oldFNames} {return $fullNames}
  61.     set oldFNames $fullNames
  62.     
  63.     if {[catch {set nms [array names winNameToNum]}] == "1"} {
  64.         return $fullNames
  65.     }
  66.     
  67.     if {$fullNames == "1"} {
  68.         foreach name $nms {
  69.             if {$winNameToNum($name) < 10} {
  70.                 set lab /$winNameToNum($name)
  71.             } else {set lab ""}
  72.             regexp {[^:]*$} $name nm
  73.             catch {deleteMenuItem -m $winMenu $nm}
  74.             addMenuItem -m -l $lab $winMenu $name
  75.         }
  76.     } else {
  77.         foreach name $nms {
  78.             if {$winNameToNum($name) < 10} {
  79.                 set lab /$winNameToNum($name)
  80.             } else {set lab ""}
  81.             regexp {[^:]*$} $name nm
  82.             catch {deleteMenuItem -m $winMenu $name}
  83.             addMenuItem -m -l $lab $winMenu $nm
  84.         }
  85.     }
  86.     return $fullNames
  87. }
  88.  
  89. # This file contains methods allowing the shadowing of tcl variables 
  90.  
  91. initFlag autoHScroll
  92. initFlag autoSave
  93. initTclFlag backup
  94. initFlag blinkingCursor
  95. initFlag blockCursor
  96. initFlag bwWindows
  97. initFlag coloring
  98. initFlag dragAndDrop
  99. initTclFlag elecLBrace
  100. initTclFlag elecRBrace
  101. initTclFlag electricSemi
  102. initFlag fullNames
  103. trace vdelete fullNames w shadowFullNames
  104. trace variable fullNames w shadowFullNames
  105. initFlag horScrollBar
  106. initFlag hyperText
  107. initTclFlag iconifyOnSwitch
  108. initFlag indentOnCR
  109. initTclFlag infoWindowsDirty 1
  110. initTclFlag intelCutPaste 1
  111. catch {initFlag lockStatus}
  112. initFlag maskCapsLock 1
  113. initFlag moveInsertion
  114. initFlag noDelete
  115. initFlag openAllFiles
  116. initFlag optionIsMeta
  117. initFlag posActivate
  118. initFlag powerThumb
  119. initFlag projectorAware
  120. initFlag showRowCol
  121. initFlag showInvisibles
  122. initFlag showMode
  123. catch {initFlag showPlatform}
  124. initTclFlag smartQuotes 1
  125. initFlag sortedIsDefault
  126. initFlag suppressHeader
  127. initFlag tempMem
  128. initFlag undoOn
  129. initFlag wordWrap
  130.  
  131. initTclVar backExtension "~"
  132. initTclVar backDir
  133. set backDir ""
  134. initVar bottomMargin
  135. initVar changesLim
  136. initVar defaultFont
  137. initVar defHeight
  138. initVar defLeft     3
  139. initVar defTop         40
  140. initVar defWidth
  141. initTclVar diffFlags { }
  142. initVar fillColumn
  143. initVar fontSaving
  144. initVar fontSize
  145. initVar funcExpr
  146. initVar funcPar
  147. initVar leftFillColumn
  148. initVar leftMargin
  149. initTclVar numWinsToTile 2
  150. initVar paraColumn
  151. initVar    printerFont
  152. initVar    printerFontSize
  153. initVar savedState
  154. initVar sortColumn
  155. initVar tabSize
  156. initVar tagFile
  157. initTclVar tileHeight
  158. initTclVar tileLeft 4
  159. initTclVar tileTop
  160. initTclVar tileWidth
  161. initVar topMargin
  162. initVar wordBreak
  163. initVar wordBreakPreface
  164.  
  165. # Redefine 'menuHook' to update flags menu.
  166. proc menuHook {} {
  167.     uplevel #0 {
  168.         foreach f $allFlags {
  169.             markMenuItem globalFlags $f [set $f]
  170.         }
  171.     }
  172. }
  173.